home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue27 / archaeop / DinoSource / PaletteTweaking.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-09-17  |  8.8 KB  |  265 lines
  1. unit PaletteTweaking;
  2.  
  3. interface
  4.  
  5. implementation
  6.  
  7. uses
  8.   CommonStuff, ExtCtrls, Menus, SysUtils, Dialogs, Classes, Windows,
  9.   CommCtrl, Messages, Forms;
  10.  
  11. type
  12.   TPaletteTweaking = class(TObject)
  13.   private
  14.     FTimer: TTimer;
  15.     FMultilineOption,
  16.     FHotTrackOption,
  17.     FButtonsOption,
  18.     FToolsOptions: TMenuItem;
  19.     FOldOnResize,
  20.     FOldToolsOptionsOnClick: TNotifyEvent;
  21.   protected
  22.     procedure DoConfigurePaletteClick(Sender: TObject);
  23.     procedure DoPaletteOptions(Sender: TObject);
  24.     procedure DoTimer(Sender: TObject);
  25.     procedure DoResize(Sender: TObject);
  26.     procedure UpdateIDESize(OldRowCount: Integer);
  27.     procedure SetMultiLine(Value: Boolean);
  28.     procedure SetHotTrack(Value: Boolean);
  29.     procedure SetButtons(Value: Boolean);
  30.   public
  31.     constructor Create;
  32.     destructor Destroy; override;
  33.   end;
  34.  
  35. resourcestring
  36.   SMultiLine = '&Multiline';   //Multiline toggle option
  37.   SHotTrack = '&Hot tracking'; //Hot-tracking toggle option
  38.   SButtons = '&Buttons instead of tabs'; //Tabs as buttons toggle option
  39.  
  40. const
  41.   SToolsOptions = 'ToolsOptionsItem'; //Tools | Environment Options...
  42.   SToolsOptionsOnClick = 'ToolsOptions'; //OnClick handler for above
  43.   SMainFormOnResize = 'WindowResize'; //OnResize handler for main form
  44.   SMsgDlgClass = 'TMessageForm'; //Class name of a MessageDlg form
  45.   //Registry strings
  46.   SRegMultiLine = 'Multi-line Component Palette';
  47.   SRegButtons = 'Tabs As Buttons';
  48.   SRegHotTrack = 'Hot Tracking';
  49.   SRegTabHeight = 'Tab Height';
  50.  
  51. constructor TPaletteTweaking.Create;
  52. begin
  53.   inherited Create;
  54.   //Make sure there is an options menu - bear in mind
  55.   //that the other options code might not be being used
  56.   Stuff.AddOptionsItem;
  57.   //Set up the hot track, multiline and buttons menu items
  58.   FMultilineOption := NewItem(SMultiLine, 0,
  59.     Stuff.Ini.ReadBool(SRegSection, SRegMultiLine,
  60.       Stuff.FTabControl.MultiLine),
  61.     True, DoPaletteOptions, 0, '');
  62.   FHotTrackOption := NewItem(SHotTrack, 0,
  63.     Stuff.Ini.ReadBool(SRegSection, SRegHotTrack,
  64.       Stuff.FTabControl.HotTrack),
  65.     True, DoPaletteOptions, 0, '');
  66.   FButtonsOption := NewItem(SButtons, 0,
  67.     Stuff.Ini.ReadBool(SRegSection, SRegButtons,
  68.       GetWindowLong(Stuff.FTabControl.Handle, gwl_Style) and
  69.         tcs_Buttons <> 0),
  70.     True, DoPaletteOptions, 0, '');
  71.   //All 3 items use the same handler - Tag distinguishes them
  72.   FMultilineOption.Tag := 1;
  73.   FHotTrackOption.Tag := 2;
  74.   FButtonsOption.Tag := 3;
  75.   //Insert the option menu items
  76.   Stuff.FOptions.Add(FMultilineOption);
  77.   Stuff.FOptions.Add(FHotTrackOption);
  78.   Stuff.FOptions.Add(FButtonsOption);
  79.   //To help avoid flickering, we chain into an IDE event handler
  80.   //This may cause problems if someone else chains on to it
  81.   //afterwards, and then we are deleted. The later chainer will
  82.   //be referring to dead code -> AV time
  83.   //Note that we do check to see if the event is already
  84.   //chained and warn the user if so
  85.  
  86.   //Find Tools | Environment Options...
  87.   FToolsOptions := GetComponent(Application.MainForm, SToolsOptions,
  88.     SGenericError + SToolsOptions) as TMenuItem;
  89.   //Save old OnClick handler
  90.   FOldToolsOptionsOnClick := FToolsOptions.OnClick;
  91.   //Warn user if event was already chained
  92.   TestChainedEventHandler(TMethod(FOldToolsOptionsOnClick).Code,
  93.     Application.MainForm.MethodAddress(SToolsOptionsOnClick));
  94.   //Replace Delphi's event handler with our own
  95.   FToolsOptions.OnClick := DoConfigurePaletteClick;
  96.   //Trap IDE form resizing - save old OnResize event
  97.   FOldOnResize := Application.MainForm.OnResize;
  98.   //Warn user if event was already chained
  99.   TestChainedEventHandler(TMethod(FOldOnResize).Code,
  100.     Application.MainForm.MethodAddress(SMainFormOnResize));
  101.   //Replace Delphi's event handler with our own
  102.   Application.MainForm.OnResize := DoResize;
  103.  
  104.   //Set the palette properties as dictated by registry
  105.   //This should really be done here, but the multi-line stuff
  106.   //can't manage to make the IDE window larger when
  107.   //Delphi is starting so we do it in a timer event instead
  108.   FTimer := TTimer.Create(nil);
  109.   FTimer.OnTimer := DoTimer;
  110.   FTimer.Interval := 500;
  111. end;
  112.  
  113. destructor TPaletteTweaking.Destroy;
  114. begin
  115.   //Save option states
  116.   Stuff.Ini.WriteBool(SRegSection, SRegMultiLine, FMultilineOption.Checked);
  117.   Stuff.Ini.WriteBool(SRegSection, SRegHotTrack, FHotTrackOption.Checked);
  118.   Stuff.Ini.WriteBool(SRegSection, SRegButtons, FButtonsOption.Checked);
  119.   //Tidy up timer
  120.   FTimer.Free;
  121.   //Get rid of customisations from IDE
  122.   SetMultiLine(False);
  123.   SetHotTrack(False);
  124.   SetButtons(False);
  125.   //Unchain the chained event handlers
  126.   if Assigned(FToolsOptions) then
  127.     FToolsOptions.OnClick := FOldToolsOptionsOnClick;
  128.   if Assigned(FOldOnResize) then
  129.     Application.MainForm.OnResize := FOldOnResize;
  130.   inherited Destroy
  131. end;
  132.  
  133. procedure TPaletteTweaking.DoConfigurePaletteClick(Sender: TObject);
  134. begin
  135.   //To avoid the excess flicker of the multi-line
  136.   //component palette, we'll try turning it off when
  137.   //it would normally flicker
  138.   SetMultiLine(False);
  139.   //Chain onto old OnClick handler
  140.   if (Sender = FToolsOptions) and
  141.      Assigned(FOldToolsOptionsOnClick) then
  142.     FOldToolsOptionsOnClick(Sender);
  143.   //Set back old value
  144.   SetMultiLine(FMultilineOption.Checked);
  145. end;
  146.  
  147. procedure TPaletteTweaking.DoPaletteOptions(Sender: TObject);
  148. begin
  149.   //Toggle options as requested
  150.   with Sender as TMenuItem do
  151.   begin
  152.     Checked := not Checked;
  153.     case Tag of
  154.       1: SetMultiLine(Checked);
  155.       2: SetHotTrack(Checked);
  156.       3: SetButtons(Checked);
  157.     end
  158.   end
  159. end;
  160.  
  161. procedure TPaletteTweaking.DoTimer(Sender: TObject);
  162. begin
  163.   //This triggers shortly after Delphi starts
  164.   //(or whenever this package is initialised)
  165.  
  166.   //Only perform the settings if there is no error
  167.   //message (such as a package load failure). Errors
  168.   //are shown with MessageDlgs which are of type
  169.   //TMessageForm. Let the timer keep running until
  170.   //it's gone so the settings do actually take effect
  171.   if not (Screen.ActiveForm.ClassName = SMsgDlgClass) then
  172.   begin
  173.     FTimer.Enabled := False;
  174.     SetMultiLine(FMultilineOption.Checked);
  175.     SetHotTrack(FHotTrackOption.Checked);
  176.     //Don't need to call this as both the
  177.     //previous routines do it anyway
  178.     //SetButtons(FButtonsOption.Checked);
  179.   end
  180. end;
  181.  
  182. procedure TPaletteTweaking.DoResize(Sender: TObject);
  183. var
  184.   OldRows: Integer;
  185. begin
  186.   //IDE is being resized - how many tab rows are there right now?
  187.   OldRows := Stuff.FTabControl.Perform(tcm_GetRowCount, 0, 0);
  188.   //Chain onto old OnResize event
  189.   if Assigned(FOldOnResize) then
  190.     FOldOnResize(Sender);
  191.   //Resync component palette's multiline situation
  192.   UpdateIDESize(OldRows);
  193. end;
  194.  
  195. procedure TPaletteTweaking.UpdateIDESize(OldRowCount: Integer);
  196. var
  197.   Rows: Integer;
  198. begin
  199.   //If component palette has decided to have
  200.   //a different number of lines then...
  201.   Rows := Stuff.FTabControl.Perform(tcm_GetRowCount, 0, 0) - OldRowCount;
  202.   if Rows = 0 then Exit;
  203.   //Need more/less room for the tab rows
  204.   //Store how much we increased by, so we can
  205.   //decrease the same amount when asked to
  206.   Stuff.FTabControl.Height := Stuff.FTabControl.Height +
  207.     Rows * Stuff.Ini.ReadInteger(SRegSection,
  208.       SRegTabHeight, Stuff.FTabControl.TabHeight);
  209.   //Tell main form to resize according to tab control's height
  210.   with Application.MainForm do
  211.     PostMessage(Handle, wm_Size,
  212.       size_Restored, MakeLong(Width, Height));
  213. end;
  214.  
  215. procedure TPaletteTweaking.SetMultiLine(Value: Boolean);
  216. var
  217.   OldRows: Integer;
  218. begin
  219.   OldRows := Stuff.FTabControl.Perform(tcm_GetRowCount, 0, 0);
  220.   Stuff.FTabControl.MultiLine := Value;
  221.   //If MultiLine property changes, the window gets
  222.   //recreated so we need to set button status back as appropriate
  223.   //since we hacked that option - it ain't a property
  224.   SetButtons(FButtonsOption.Checked);
  225.   UpdateIDESize(OldRows);
  226. end;
  227.  
  228. procedure TPaletteTweaking.SetHotTrack(Value: Boolean);
  229. begin
  230.   Stuff.FTabControl.HotTrack := Value;
  231.   //If HotTrack property changes, the window gets
  232.   //recreated so we need to set buttons back as appropriate
  233.   //since we hacked that option - it ain't a property
  234.   SetButtons(FButtonsOption.Checked)
  235. end;
  236.  
  237. procedure TPaletteTweaking.SetButtons(Value: Boolean);
  238. var
  239.   Style: Longint;
  240. begin
  241.   //TTabControl/TPageControl doesn't make
  242.   //buttons facility available as a property
  243.   Style := GetWindowLong(Stuff.FTabControl.Handle, gwl_Style);
  244.   if Value then
  245.     Style := Style or tcs_Buttons
  246.   else
  247.     Style := Style and not tcs_Buttons;
  248.   //Set desired window style
  249.   SetWindowLong(Stuff.FTabControl.Handle, gwl_Style, Style);
  250. end;
  251.  
  252. var
  253.   PaletteTweakingObject: TPaletteTweaking;
  254.  
  255. initialization
  256.   try
  257.     PaletteTweakingObject := TPaletteTweaking.Create
  258.   except
  259.     on E: Exception do
  260.       ShowMessage(SSetupError + ': ' + E.Message)
  261.   end
  262. finalization
  263.   PaletteTweakingObject.Free
  264. end.
  265.